perm filename MAKEML.SAI[MNT,CSR]1 blob
sn#229920 filedate 1976-08-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 MAKEML
C00004 00003 the BUILD procedure
C00007 00004 more build the loop
C00010 00005 more bulid
C00013 00006 more build
C00016 00007 more build the check
C00020 00008 more build open the files
C00022 00009 the MAKE procedure
C00029 00010 the MAKE procedure
C00034 00011 more make
C00040 00012 more make the report
C00046 00013 some HELP
C00052 00014 MAKEML runs:
C00065 ENDMK
C⊗;
COMMENT MAKEML;
ENTRY;
BEGIN
EXTERNAL PROCEDURE BAIL;
INTERNAL PROCEDURE MAKEML;
BEGIN "MAKEML"
EXTERNAL INTEGER C1,C2,PL,COUNT,DSKCT,BRCHAR,NUMBER,JMP,REC,PG,C3;
EXTERNAL INTEGER C4,LINELB,LINEST,COPIES;
EXTERNAL REAL PRICER,BASE;
EXTERNAL BOOLEAN EOF,FLAG,EF1,UP;
EXTERNAL STRING TYPEIN,STT,PAGE,LINE,HEADER,HASH,PAT;
EXTERNAL STRING ARRAY ADDRESS[0:5],HASHTB[0:NUMBER+2];
EXTERNAL PROCEDURE FINDER;
INTEGER ARRAY MIKE[1:25],HARD[1:25],PCT[1:50];
STRING ARRAY BDDRE[1:5];
INTEGER I,J,K,DUM,TOT,IT;
STRING MONTH,ENT,ENTRY,ESTRING;
BOOLEAN LOOKING,NEW;
REQUIRE "⊂⊃" DELIMITERS;
DEFINE CRLF=⊂'15&'12⊃;
DEFINE PRT=⊂PRINT(CRLF⊃;
DEFINE PRTERR=⊂PRT,"THE LEGAL RESPONSES ARE:",CRLF,CRLF⊃;
DEFINE TTIN=⊂CLRBUF; TYPEIN←TTYINL(1,BRCHAR); WHILE EQU(TYPEIN[1 TO 1]," ")
DO DUM←LOP(TYPEIN);⊃;
DEFINE SCIN=⊂LINE←SCAN(PAGE,1,BRCHAR);⊃;
DEFINE PGIN=⊂USETI(C3,I); PAGE←INPUT(C3,2);
WHILE LENGTH(PAGE)<5 DO PAGE←INPUT(C3,2);⊃;
COMMENT Obtain a pseudo teletype to use when writting on
the address file;
DEFINE ETVIN=⊂PL←PTYGET;
PTOSTR(PL,"L USE.CSR"&'15&'12);
STT←PTYIN(PL,5,BRCHAR);
I←'4226000000; PTYSTL(PL,I);⊃;
DEFINE ETVOUT=⊂PTOSTR(PL,"K"&'15&'12);
STT←PTYIN(PL,10,BRCHAR);⊃;
COMMENT the BUILD procedure;
SIMPLE PROCEDURE BUILD;
BEGIN "BLD"
COMMENT this procedure is called to interactively build the
monthly report file (REPT.DSK) and open the order file
(ORDER.DSK). It receives as input the page header line
which contains the month, record, and page;
INTEGER NXT,PAGER,RECNUM,PROCESSED,EXISTING,COUNT;
BOOLEAN BUILDING;
STRING ENT,ENTREE,HLD;
DEFINE ENTADD=⊂SETFORMAT(1,1); IF NXT<9 THEN ENT←ENT&CVS(NXT←NXT+1)&"," ELSE
BEGIN NXT←NXT+1; ENT←ENT&(NXT+55)&","; END; SETFORMAT(-4,2);⊃;
DEFINE IFF=⊂IF(EQU(TYPEIN[1 TO 1],"?")) OR
(EQU(TYPEIN[1 TO 4],"HELP")) OR
(EQU(TYPEIN[1 TO 1],'15))⊃;
DEFINE NOTE=⊂PRT,"NOTE - A PRICE IS NECESSARY, INPUT EITHER A PRICE, ",
CRLF,"OR PAGE ESTIMATE THIS CAN BE CHANGED AT BILLING TIME.");⊃;
DEFINE NNNN=⊂IF (NOT EQU(TYPEIN[1 TO 2],"NO")) AND
((TYPEIN[1 TO 1]>'71) OR
(TYPEIN[1 TO 1]<'60)) THEN
BEGIN
PRTERR, " ####<cr> NUMBER OF COPIES AVAILABLE",CRLF,
" NO<cr> IF NOT AVAILABLE AT THIS TIME OR NO LIMIT");
CONTINUE;
END;⊃;
BUILDING←TRUE;
MONTH←LINE[14 TO 16];
RECNUM←CVD(LINE[2 TO 6]);
PAGER←CVD(LINE[8 TO 12]);
EXISTING←CVD(LINE[26 TO 29]);
NXT←0;
IF NOT NEW THEN BEGIN NXT←LINE[39 TO 39]; NXT←NXT-'60; IF NXT>9 THEN NXT←NXT-7; END;
COUNT←0;
COMMENT more build the loop;
COMMENT the entry will be assembled and approved through operator
interaction with the operator within a loop. ENT is the
string used to build up the entry, and upon approval it will
be entered into the string ENTREE for subsequent inclusion
into the file REPT.DSK. (the ents are coming);
WHILE BUILDING DO
BEGIN
COMMENT receive the report numbers;
WHILE LOOKING DO
BEGIN
PRT,"REPORT NUMBER *");
TTIN;
IF EQU(TYPEIN[1 TO 1],'15) THEN
BEGIN
IF COUNT=0 THEN RETURN;
BUILDING←FALSE;
DONE;
END;
IFF OR ((NOT EQU(TYPEIN[1 TO 2],"AI"))
AND (NOT EQU(TYPEIN[1 TO 2],"ST"))) THEN PRTERR,
" STAN-CS465-AIM154<cr> CS REPORT NUMBER WITH AN OPTIONAL",CRLF,
" EXTENSION (ie AIM,SLACR,AI,TN,OR)",CRLF,
" MUST BEGIN WITH STAN OR AIM ",CRLF,
" <cr> IF NO MORE ENTRIES ARE TO BE ",CRLF,
" MADE. ",CRLF,
" ?<cr> OR ANY INPUT EXCEPT THOSE ABOVE",CRLF,
" GIVE YOU THIS. ",CRLF);
IF EQU(TYPEIN[1 TO 2],"AI") OR
EQU(TYPEIN[1 TO 2],"ST") THEN
BEGIN
ENT←"*"&TYPEIN[1 TO (LENGTH(TYPEIN)-1)]&"|";
ENTADD;
DONE;
END;
END;
IF NOT BUILDING THEN DONE;
COMMENT the number of hardcopies;
WHILE LOOKING DO
BEGIN
PRT,"NUMBER OF HARDCOPIES AVAILABLE *");
TTIN; NNNN;
IF NOT EQU(TYPEIN[1 TO 2],"NO") THEN
ENT←ENT&CVS(CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)])) ELSE ENT←ENT&"NONO";
ENT←ENT&",0000,";
DONE;
END;
TYPEIN← "";
COMMENT more bulid ;
COMMENT time to determine the price;
WHILE LOOKING DO
BEGIN
SETFORMAT(-4,2);
IF EQU(TYPEIN[1 TO 2],"NO") THEN NOTE;
PRT,"PRICE(NN.NN ie 19.76) $");
TTIN; TYPEIN←TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
IF EQU(TYPEIN[1 TO 1],"$") THEN DUM←LOP(TYPEIN);
IF EQU(TYPEIN[1 TO 4],"COMP") THEN
BEGIN
PRT,"NUMBER OF PAGES *");
TTIN;
NNNN;
TYPEIN←CVF(BASE+PRICER*CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]));
WHILE EQU(TYPEIN[1 TO 1]," ") DO TYPEIN←TYPEIN[2 TO 11];
SETFORMAT(1,1);
IF TYPEIN[LENGTH(TYPEIN) TO LENGTH(TYPEIN)]>'67 THEN
TYPEIN←TYPEIN[1 TO LENGTH(TYPEIN)-2]&CVS((CVD(TYPEIN[LENGTH(TYPEIN)-1 TO LENGTH(TYPEIN)-1])+1) MOD 10)&0;
IF TYPEIN[LENGTH(TYPEIN) TO LENGTH(TYPEIN)]<'63 OR
TYPEIN[LENGTH(TYPEIN) TO LENGTH(TYPEIN)]>'67 THEN
TYPEIN←TYPEIN[1 TO LENGTH(TYPEIN)-1]&"0" ELSE
TYPEIN←TYPEIN[1 TO LENGTH(TYPEIN)-1]&"5";
PRT,"THE COMPUTED PRICE IS $",TYPEIN);
SETFORMAT(-4,2);
END;
IF (TYPEIN[1 TO 1]<'60) OR (TYPEIN[1 TO 1]>'71) THEN
BEGIN
PRTERR, " COMPute<cr> THE PRICE WILL BE COMPUTED, BUT ",CRLF,
" THE NUMBER OF PAGES MUST BE INPUT",CRLF,
" DD.DD<cr> PRICE: TWO DIGITS, A DECIMAL POINT",CRLF,
" FOLLOWED BY TWO DECIMALS (ie 04.23)",CRLF);
CONTINUE;
END;
WHILE LENGTH(TYPEIN)<5 DO TYPEIN←"0"&TYPEIN;
IF EQU(TYPEIN[1 TO 1],"N") THEN CONTINUE
ELSE
BEGIN
ENT←ENT&TYPEIN[1 TO 5]&"|";
DONE;
END;
END;
ENTADD;
WHILE LOOKING DO
BEGIN
PRT,"NUMBER OF MICROFICHE AVAILABLE *");
TTIN;
NNNN;
IF NOT EQU(TYPEIN[1 TO 2],"NO") THEN
ENT←ENT&CVS(CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]))
ELSE ENT←ENT&"NONO";
ENT←ENT&",0000|";
DONE;
END;
J←0;
COMMENT more build;
COMMENT process the accounting information;
I←J←0; HLD←"";
WHILE LOOKING DO
BEGIN
PRT,"ACCOUNT *"); TTIN;
IF EQU(TYPEIN[1 TO 1],"?") THEN
BEGIN
PRT,"THE ACCOUNT NUMBER OF ONE OF THE INDIVIDUALS SPONSORING THE REPORT.");
PRT,CRLF,"A REPORT MAY HAVE ANY NUMBER OF SPONSORS, AS LONG AS THE TOTAL IS 100%.");
CONTINUE;
END;
STT←"";
STT←STT&TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
PRT,"PERCENT *"); TTIN;
IF (LENGTH(TYPEIN)>4) OR
(TYPEIN[1 TO 1]<'60) OR
(TYPEIN[1 TO 1]>'71) THEN
BEGIN
PRT,"PERCENTAGES MUST BE ENTERED AS TWO DECIMALS OR 100");
CONTINUE;
END;
J←CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]);
I←I+J;
SETFORMAT(2,2);
HLD←HLD&STT&"."&CVS(J-1)&",";
SETFORMAT(-4,2);
IF I=100 THEN DONE;
IF I<100 THEN
BEGIN
SETFORMAT(3,2);
PRT,CVS(I),"% ALLOCATED, THE TOTAL MUST EQUAL 100");
SETFORMAT(-4,2);
CONTINUE;
END;
IF I>100 THEN
BEGIN
I←J←0;
HLD←"";
PRT,"ERROR, OVER 100%, REINPUT ALL ACCOUNTS AND PERCENTAGES");
CONTINUE;
END;
SETFORMAT(-4,2);
DONE;
END;
ENT←ENT&HLD;
SETFORMAT(1,1);
J←0;
PRT,"ONR REPORT (Y OR N)? *"); TTIN;
IF EQU(TYPEIN[1 TO 1],"Y") THEN J←1;
PRT,"ARPA REPORT (Y OR N)? *"); TTIN;
IF EQU(TYPEIN[1 TO 1],"Y") THEN J←J+2;
ENT←ENT[1 TO (LENGTH(ENT)-1)]&"|"&CVOS(J)&'15&'12;
SETFORMAT(-4,2);
COMMENT more build the check;
COMMENT this loop will ask for approval of the entry if it
is given the ENT will be included in ENTREE for later
inclusion into the REPT.DSK file, if the entry is
disapproved the entry will be discarded, and the operator
must start over. If anything else is input the opeator
will be given an explanation, and the chance to approve;
WHILE LOOKING DO
BEGIN
PRT,CRLF,"THIS IS THE CODED ENTRY:",CRLF,ENT);
PRT,"IS IT OK (Y,N,?)"); TTIN;
IF EQU(TYPEIN[1 TO 1],"Y") THEN
BEGIN
ENTREE←ENTREE&ENT;
COUNT←COUNT+1;
DONE;
END;
IF EQU(TYPEIN[1 TO 1],"N") THEN
BEGIN
IF NXT=64 THEN NXT←9;
IF NXT=63 THEN NXT←8;
PRT,"THE ENTRY WILL BE DISCARDED, AND YOU CAN RESTART");
NXT←NXT-2; IF NXT=64 THEN NXT←9; IF NXT=63 THEN NXT←8;
DONE;
END;
COMMENT this is the default explanation of the entry that loops back
to the approval cycle;
PRTERR,
" Y<cr> approval, the entry will be included ",CRLF,
" N<cr> disapproval, the entry will be discarded",CRLF,
" (default) anything else will give you this, and ",CRLF,
" then give you another chance to approve.",CRLF,CRLF,
" *CSXXX-AIXX|H,NNNN,0000,PP.PP|M,NNNN,0000|AAAA.%%|Y ",CRLF,
" ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ |Y=1 ONR REPORT",CRLF,
" ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ |Y=2 ARPA REPORT",CRLF,
" ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ |Y=3 BOTH ARPA&ONR",CRLF,
" ↓ ↓ ↓ ↓ ↓ ↓ ↓ ↓ ACCOUNT # AND PERCENT-1",CRLF,
" ↓ ↓ ↓ ↓ ↓ ↓ ↓ NUMBER FICHE ORDERED (ACCOUNTING)",CRLF,
" ↓ ↓ ↓ ↓ ↓ ↓ NUMBER OF MICROFICHE",CRLF,
" ↓ ↓ ↓ ↓ ↓ ↓ NONO NOT AVAILABLE OR UNLIMITED",CRLF,
" ↓ ↓ ↓ ↓ ↓ COMPUTED ORDER NUMBER FOR MICROFICHE",CRLF,
" ↓ ↓ ↓ ↓ PRICE PER HARDCOPY ",CRLF,
" ↓ ↓ ↓ NUMBER OF HARDCOPIES ORDERED ",CRLF,
" ↓ ↓ NUMBER HARD COPIES AVAILABLE ",CRLF,
" ↓ COMPUTED HARDCOPY ORDER NUMBER ",CRLF,
" CS REPORT NUMBER WITH OPTIONAL EXTENSION ");
END;
END;
COMMENT more build open the files;
COMMENT the entree will nowbe included into the REPT.DSK file
and the ORDER.DSK file will be opened;
DEFINE INSERT=⊂PTOSTR(PL,ESTRING); ESTRING←'175; PTOSTR(PL,ESTRING);
STT←PTYIN(PL,4,BRCHAR); PTOSTR(PL,"1D"); STT←PTYIN(PL,4,BRCHAR);⊃;
ETVIN;
WHILE LOOKING DO
BEGIN
CLOSE(C3);
PTOSTR(PL,"ET REPT.DSK"&'15&'12);
STT←PTYIN(PL,12,BRCHAR);
ESTRING←CVS(PAGER)&"PI"&MONTH&"*ENTRIES="&CVS(COUNT+EXISTING);
SETFORMAT(1,1);
IF NXT<10 THEN NXT←NXT+'60 ELSE NXT←NXT+55;
ESTRING←ESTRING&" REPORTS="&NXT&'15&'12;
SETFORMAT(-4,2);
INSERT;
IF NEW THEN
BEGIN
ESTRING←"∞D";
PTOSTR(PL,ESTRING);
STT←PTYIN(PL,4,BRCHAR);
END;
ESTRING←"∞LI"&ENTREE;
INSERT;
PTOSTR(PL,"E");
STT←PTYIN(PL,5,BRCHAR);
COMMENT now prepare ORDER.DSK;
LOOKUP(C3,"ORDER.DSK",FLAG);
I←1;PGIN;
DO BEGIN SCIN; END UNTIL EQU(LINE[14 TO 16],MONTH);
SETFORMAT(1,1);
ESTRING←LINE[8 TO 12]&"PI"&MONTH&"*ORDERS=0000 REPORTS="&NXT&'15&'12;
SETFORMAT(-4,2);
CLOSE(C3);
PTOSTR(PL,"ET ORDER.DSK"&'15&'12);
STT←PTYIN(PL,12,BRCHAR);
INSERT;
PTOSTR(PL,"∞DE");
STT←PTYIN(PL,5,BRCHAR);
DONE;
END;
ETVOUT;
END "BLD";
COMMENT the MAKE procedure;
SIMPLE PROCEDURE MAKE;
BEGIN "MAKE"
COMMENT this procedure uses two subprocedure to produce the
output for the MAKEML function:
LABELS: outputs the mailing labels to a file to
be listed of gum labels when you are ready.
FORM: outputs the mailing order list for the
XGP, number of copies is a data base item
and provides the summary data;
INTEGER USA,FNR,RUS,IDM,ONR,ARP,AUT,FRE,COUNT,L1;
SIMPLE PROCEDURE LABELS;
BEGIN
STRING ADDER;
BOOLEAN LOPP,CHES;
INTEGER CSST,CHA;
SETFORMAT(5,2);
CLOSE(C4);
ENTER(C4,MONTH[1 TO 3]&"LAB",FLAG); USETO(C4,1);
USA←FNR←RUS←IDM←ONR←ARP←AUT←FRE←COUNT←0; LOPP←TRUE;
COMMENT the leader info;
ADDER←"";
IF LINEST>1 THEN
FOR I←1 STEP 1 UNTIL LINEST-1 DO ADDER←ADDER&'15&'12;
ADDER←ADDER&"COMPUTER SCIENCE DEPARTMENT"&'15&'12&"LIBRARY AND PUBLICATIONS "
&"COMMITTEE"&'15&'12&MONTH&" ABSTRACT MAILING LIST"&'15&'12;
FOR I←1 STEP 1 UNTIL LINELB-3 DO ADDER←ADDER&'15&'12;
OUT(C4,ADDER); ADDER←"";
CLOSE(C2); LOOKUP(C2,"ADDFIL.DSK",FLAG); USETI(C2,1);
CSST←1;
DEFINE LOCAT=⊂IF EQU(ADDRESS[0][2 TO 2]⊃;
COMMENT now print the lables;
TOT←0;
COMMENT determint which type of labels to use;
WHILE LOPP DO
BEGIN
PRT,"Are Cheshire labels to be printed? (Y or N)*");
TTIN;
IF EQU(TYPEIN[1 TO 1],"Y") THEN BEGIN CHES←TRUE; DONE; END;
IF EQU(TYPEIN[1 TO 1],"N") THEN BEGIN CHES←FALSE; DONE; END;
PRTERR," Yes Will cause to labels to be printed in the format",CRLF,
" necessary for automatic label processing.",CRLF,
" No Will cause the labels to be printed in the format",CRLF,
" for AVERY labels.");
END;
IF NOT CHES THEN
BEGIN
FOR J←1 STEP 1 UNTIL NUMBER DO
BEGIN
HASH←HASHTB[J][1 TO 5];
IF EQU(HASH,"#####") THEN BEGIN TOT←TOT+1; CONTINUE; END;
REC←CVD(HASHTB[J][6 TO 10]);
USETI(C2,REC);
DO PAGE←INPUT(C2,2) UNTIL EQU(PAGE[1 TO 1],"*");
SCIN;
HEADER←LINE;
JMP←-4;
DO JMP←JMP+6 UNTIL EQU(HASH[1 TO 5],HEADER[JMP TO JMP+4]);
IF NOT EQU(HASH[1 TO 5],"#####") THEN
BEGIN
FOR IT←2 STEP 1 UNTIL JMP-1 DO SCIN;
FOR IT←1 STEP 1 UNTIL 6 DO
BEGIN
ADDRESS[IT-1]←SCAN(PAGE,1,BRCHAR);
IF LENGTH(ADDRESS[IT-1])>36 THEN
ADDRESS[IT-1]←ADDRESS[IT-1][1 TO 35]&'15;
END;
END;
COMMENT this is to gather some summary data;
IF ADDRESS[0][3 TO 3]<'72 THEN USA←USA+1;
IF EQU(ADDRESS[0][3 TO 7],"IDMAI") THEN IDM←IDM+1;
IF EQU(ADDRESS[0][3 TO 6],"USSR") THEN RUS←RUS+1;
IF (ADDRESS[0][3 TO 3]≥'72) AND
(NOT EQU(ADDRESS[0][3 TO 7],"IDMAI")) AND
(NOT EQU(ADDRESS[0][3 TO 6],"USSR")) THEN FNR←FNR+1;
LOCAT,"N") THEN ONR←ONR+1;
LOCAT,"M") THEN ARP←ARP+1;
LOCAT,"A") THEN AUT←AUT+1;
LOCAT,"F") THEN FRE←FRE+1;
COMMENT move in the zip code;
IF ((ADDRESS[0][3 TO 3]≤'71) AND (ADDRESS[0][3 TO 3]≥'60)) THEN
BEGIN
K←5;
WHILE LENGTH(ADDRESS[K])<5 DO K←K-1;
IF K<5 THEN ADDRESS[K+1]←" "&ADDRESS[0][3 TO 7]&'15
ELSE
BEGIN
ADDRESS[K]←ADDRESS[K][1 TO LENGTH(ADDRESS[K])-1]&" ";
ADDRESS[K]←ADDRESS[K][1 TO 27]&" "&ADDRESS[0][3 TO 7]&'15;
END;
END;
COMMENT now insert the hashcode;
ADDRESS[1]←ADDRESS[1][1 TO LENGTH(ADDRESS[1])-1]&" ";
ADDRESS[1]←ADDRESS[1][1 TO 27]&" #"&ADDRESS[0][22 TO 26]&'15;
IF NOT EQU(ADDRESS[0][2 TO 2]," ") THEN
BEGIN
ADDRESS[2]←ADDRESS[2][1 TO LENGTH(ADDRESS[2])-1]&" ";
ADDRESS[2]←ADDRESS[2][1 TO 27]&" (FREE)"&'15;
END;
FOR I←1 STEP 1 UNTIL 5 DO ADDER←ADDER&ADDRESS[I]&'12;
FOR I←1 STEP 1 UNTIL LINELB-5 DO ADDER←ADDER&'15&'12;
CSST←CSST+1;
IF CSST=10 THEN
BEGIN
ADDER←ADDER[1 TO LENGTH(ADDER)-1]&'14;
CSST←0;
END;
IF LENGTH(ADDER)>8000 THEN BEGIN OUT(C4,ADDER); ADDER←""; END;
END;
OUT(C4,ADDER);
CLOSE(C4);
PRT,"The mailing labels have been written into the",CRLF,"file: ",
MONTH,"LAB which can be listed when the labels are available.",CRLF,
"They are formatted for AVERY labels.");
END;
COMMENT the MAKE procedure
This loop will produce the labels in Cheshire format;
IF CHES THEN
BEGIN
CHA←0;
FOR J←1 STEP 1 UNTIL NUMBER DO
BEGIN
HASH←HASHTB[J][1 TO 5];
IF EQU(HASH,"#####") THEN BEGIN TOT←TOT+1; CONTINUE; END;
REC←CVD(HASHTB[J][6 TO 10]);
USETI(C2,REC);
DO PAGE←INPUT(C2,2) UNTIL EQU(PAGE[1 TO 1],"*");
SCIN;
HEADER←LINE;
JMP←-4;
DO JMP←JMP+6 UNTIL EQU(HASH[1 TO 5],HEADER[JMP TO JMP+4]);
IF NOT EQU(HASH[1 TO 5],"#####") THEN
BEGIN
FOR IT←2 STEP 1 UNTIL JMP-1 DO SCIN;
FOR IT←1 STEP 1 UNTIL 6 DO
BEGIN
ADDRESS[IT-1]←SCAN(PAGE,1,BRCHAR);
IF LENGTH(ADDRESS[IT-1])>36 THEN
ADDRESS[IT-1]←ADDRESS[IT-1][1 TO 35]&'15;
END;
END;
COMMENT this is to gather some summary data;
IF ADDRESS[0][3 TO 3]<'72 THEN USA←USA+1;
IF EQU(ADDRESS[0][3 TO 7],"IDMAI") THEN IDM←IDM+1;
IF EQU(ADDRESS[0][3 TO 6],"USSR") THEN RUS←RUS+1;
IF (ADDRESS[0][3 TO 3]≥'72) AND
(NOT EQU(ADDRESS[0][3 TO 7],"IDMAI")) AND
(NOT EQU(ADDRESS[0][3 TO 6],"USSR")) THEN FNR←FNR+1;
LOCAT,"N") THEN ONR←ONR+1;
LOCAT,"M") THEN ARP←ARP+1;
LOCAT,"A") THEN AUT←AUT+1;
LOCAT,"F") THEN FRE←FRE+1;
COMMENT move in the zip code;
IF ((ADDRESS[0][3 TO 3]≤'71) AND (ADDRESS[0][3 TO 3]≥'60)) THEN
BEGIN
K←5;
WHILE LENGTH(ADDRESS[K])<5 DO K←K-1;
IF K<5 THEN ADDRESS[K+1]←" "&ADDRESS[0][3 TO 7]&'15
ELSE
BEGIN
ADDRESS[K]←ADDRESS[K][1 TO LENGTH(ADDRESS[K])-1]&" ";
ADDRESS[K]←ADDRESS[K][1 TO 27]&" "&ADDRESS[0][3 TO 7]&'15;
END;
END;
COMMENT now insert the hashcode;
ADDRESS[1]←ADDRESS[1][1 TO LENGTH(ADDRESS[1])-1]&" ";
ADDRESS[1]←ADDRESS[1][1 TO 27]&" #"&ADDRESS[0][22 TO 26]&'15;
IF NOT EQU(ADDRESS[0][2 TO 2]," ") THEN
BEGIN
ADDRESS[2]←ADDRESS[2][1 TO LENGTH(ADDRESS[2])-1]&" ";
ADDRESS[2]←ADDRESS[2][1 TO 27]&" (FREE)"&'15;
END;
COMMENT set up the format for the cheshire type labels;
FOR I←1 STEP 1 UNTIL 5 DO
BEGIN
ADDRESS[I]←ADDRESS[I][1 TO LENGTH(ADDRESS[I])-1];
IF LENGTH(ADDRESS[I])>35 THEN DO
ADDRESS[I]←ADDRESS[I][1 TO LENGTH(ADDRESS[I])-1]
UNTIL LENGTH(ADDRESS[I])=35;
IF LENGTH(ADDRESS[I])<35 THEN DO
ADDRESS[I]←ADDRESS[I]&" "
UNTIL LENGTH(ADDRESS[I])=35;
BDDRE[I]←BDDRE[I]&ADDRESS[I];
END;
CHA←CHA+1;
IF CHA=3 THEN
BEGIN
CHA←0;
FOR I←1 STEP 1 UNTIL 5 DO ADDER←ADDER&BDDRE[I]&'15&'12;
ADDER←ADDER&'15&'12;
FOR I←1 STEP 1 UNTIL 5 DO BDDRE[I]←"";
CSST←CSST+1;
IF CSST=10 THEN
BEGIN
ADDER←ADDER[1 TO LENGTH(ADDER)-1]&'14;
CSST←0;
IF LENGTH(ADDER)>8000 THEN BEGIN OUT(C4,ADDER); ADDER←""; END;
END;
END;
END;
OUT(C4,ADDER);
CLOSE(C4);
PRT,"The mailing labels have been written into the",CRLF,"file: ",
MONTH,"LAB which can be listed when the labels are available.",CRLF,
"They are in the CHESHIRE format, be sure to adjust the paper in the",CRLF,
"to start printing at the first line before yuo start the listing.");
END;
SETFORMAT(-4,2);
END;
COMMENT more make;
COMMENT this procedure will first make the order form, and then
do the reporting;
SIMPLE PROCEDURE FORM;
BEGIN "FORM"
STRING DATE,LETTER,H,P,M,CS,FILED,SAVER,FILETO,TITLE;
BOOLEAN FLAGER;
REAL CHARGE,PRICE,TOTAL;
INTEGER L1,L2,RPT,YY;
SETFORMAT(5,2);
ENTER(C4,"INFORM",FLAG); USETO(C4,1);
LOOKUP(C3,"REPT.DSK",FLAG);
DEFINE BLK=⊂LINE←LINE&" ";⊃;
DEFINE PUT=⊂LETTER←LETTER&LINE&'15&'12; L1←L1+1; LINE←"";⊃;
PRT,"ENTER THE CUTOFF DATE FOR ORDERS *"); TTIN;
DATE←TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
COMMENT make the leader information;
L1←1; LINE←" ";
LETTER←" STANFORD COMPUTER SCIENCE REPORT ORDER FORM"&'15&'12; PUT;
LINE←" To order reports, or change your mailing address,return this sheet by";
PUT;
LINE←DATE&" checking the reports you wish to receive."; PUT; PUT;
COMMENT process the report entries;
I←1; PGIN;
DO BEGIN SCIN; END UNTIL ((EQU(LINE[17 TO 17],"*")) OR (EQU(LINE[8 TO 10],"END")));
IF EQU(LINE[8 TO 10],"END") THEN BEGIN PRT,"ERROR - THERE IS NO OPEN REPT.DSK");
RETURN; END;
I←CVD(LINE[2 TO 6]); PGIN;
RPT←CVD(LINE[26 to 29]);
LINE←" HARDCOPY MICROFICHE"; PUT;
FILED←"";
FOR I←1 STEP 1 UNTIL RPT DO
BEGIN
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL EQU(LINE[1 TO 1],"*");
FILED←FILED&LINE;
CS←SCAN(LINE,8,BRCHAR);
H←LOP(LINE);
IF EQU(LINE[2 TO 5],"0000") THEN HARD[I]←0 ELSE HARD[I]←1;
DO DUM←LOP(LINE) UNTIL EQU(LINE[3 TO 3],".");
P←LINE[1 TO 5];
M←LINE[7 TO 7];
IF EQU(LINE[9 TO 12],"0000") THEN MIKE[I]←0 ELSE MIKE[I]←1;
LINE←H&". ___ "&CS;
L2←LENGTH(LINE); FOR J←L2 STEP 1 UNTIL 33 DO BLK;
IF HARD[I]=0 THEN LINE←H&". NOT AVAILABLE" ELSE
LINE←LINE&"$"&P;
L2←LENGTH(LINE); FOR J←L2 STEP 1 UNTIL 44 DO BLK;
IF MIKE[I]=0 THEN LINE←LINE&M&". NOT AVAILABLE" ELSE
BEGIN
LINE←LINE&M&". ___ "&CS;
L2←LENGTH(LINE); FOR J←L2 STEP 1 UNTIL 70 DO BLK;
LINE←LINE&" FREE";
END;
PUT;
END;
PUT;
COMMENT trailer for the order form;
LINE←"Please do not send money with your order, microfiche are free of charge.";
PUT;
LINE←"Check here __ to change your address, print changes on the back of this form.";
PUT;
LINE←"__________________________________________________________________________________"; PUT;
COMMENT this section will put the return address on the bottom of the form
so that it can be used as a mailer;
DEFINE MOV=⊂ FOR I←LENGTH(LINE) STEP 1 UNTIL 70 DO BLK;⊃;
DEFINE MOVD=⊂LINE←""; FOR I←1 STEP 1 UNTIL 45 DO BLK;⊃;
FOR I←L1 STEP 1 UNTIL 41 DO PUT;
LINE←"__________________________________________________________________________________"; PUT; PUT;PUT;
LINE←LINE&"COMPUTER SCIENCE DEPARTMENT";
MOV; LINE←LINE&"AFFIX"; PUT;
LINE←LINE&"STANFORD,CAL 94305";
MOV; LINE←LINE&"POSTAGE"; PUT;
FOR I←1 STEP 1 UNTIL 6 DO PUT;
MOVD; LINE←LINE&PAT; PUT;
MOVD; LINE←LINE&"LIBRARY AND PUBLICATIONS COMMITTEE"; PUT;
MOVD; LINE←LINE&"COMPUTER SCIENCE DEPARTMENT"; PUT;
MOVD; LINE←LINE&"STANFORD UNIVERSTY"; PUT;
MOVD; LINE←LINE&"STANFORD, CALIFORNIA 94305"; PUT;
LETTER←LETTER&'14;
COMMENT now input it into the file as many times as you wany copies;
FOR I←1 STEP 1 UNTIL COPIES DO
OUT(C4,LETTER);
COMMENT more make the report;
SETFORMAT(4,2);
YY←0;
LETTER←""; PUT; PUT; PUT;
LINE←"TO: LIBRARY AND PUBLICATIONS COMMITTEE"; PUT; PUT;
LINE←"SUBJECT: "&MONTH&" ABSTRACT AND MAILING SUMMARY"; PUT; PUT;
LINE←"FROM: "&PAT; PUT; PUT; PUT;
LINE←"There are a total of "&CVS(RPT)&" reports to be offered this month."; PUT;
LINE←"The order cutoff date is "&DATE&". The following reports were offered:";
PUT; PUT;
FILETO←FILED;
FOR I←1 STEP 1 UNTIL RPT DO
BEGIN
LINE←SCAN(FILED,3,BRCHAR);
PUT;
END;
PUT; PUT; PUT;
LINE←"SUMMARY OF ABSTRACTS MAILED:"; PUT; PUT;
LINE←" TOTAL "&CVS(NUMBER-TOT); PUT;
DEFINE OVER=⊂FOR I←(45-LENGTH(LINE)) DO BLK;⊃;
LINE←" US "&CVS(USA); OVER;
LINE←LINE&" ONR "&CVS(ONR); PUT;
LINE←" FOREIGN "&CVS(FNR); OVER;
LINE←LINE&" ARPA "&CVS(ARP); PUT;
LINE←" USSR "&CVS(RUS); OVER;
LINE←LINE&" AUTOMATIC "&CVS(AUT); PUT;
LINE←" IDMAI "&CVS(IDM); OVER;
LINE←LINE&" FREE "&CVS(FRE); PUT; PUT; PUT;
SETFORMAT(-4,2);
COMMENT determine who is accountable;
LINE←"ACCOUNTING DATA"; PUT;
LINE←" ACCOUNT REPORT PERCENT TOTAL PCT"; PUT; PUT;
K←0; SETFORMAT(-4,2); SAVER←LINE←""; TOTAL←CHARGE←0;
FOR I←1 STEP 1 UNTIL RPT DO
BEGIN
STT←SCAN(FILETO,9,BRCHAR);
TITLE←STT←SCAN(FILETO,8,BRCHAR);
STT←FILED[13 TO 19];
PRICE←REALSCAN(STT,BRCHAR);
TOTAL←TOTAL+PRICE;
STT←SCAN(FILETO,8,BRCHAR);
STT←SCAN(FILETO,8,BRCHAR);
COMMENT we now have an account to process in stt;
WHILE LOOKING DO
BEGIN
FLAGER←FALSE;
STT←SCAN(FILETO,10,BRCHAR);
LINE←" ";
LINE←LINE&STT; FOR J←LENGTH(LINE) STEP 1 UNTIL 25 DO BLK;
SETFORMAT(5,2);
LINE←LINE&TITLE;
FOR J←LENGTH(LINE) STEP 1 UNTIL 45 DO BLK;
LINE←LINE&" "&CVS(CVD(FILETO[1 TO 2])+1)&"%";
RUS←CVD(FILETO[1 TO 2])+1;
DUM←LOP(FILETO); DUM←LOP(FILETO);
DUM←(RUS/RPT) DIV 1;
COMMENT k is the number of accounts so far, and we will check
to see if he is already in the file ;
YY←YY+1;
IF K>0 THEN
FOR J←1 STEP 1 UNTIL YY DO
BEGIN
USA←((72*(J-1))+1);
IF EQU(SAVER[USA TO USA+24],LINE[1 TO 25]) THEN
BEGIN
DUM←DUM+CVD(SAVER[USA+65 TO USA+69]);
FLAGER←TRUE;
LINE←" "&LINE[26 TO 70];
SETFORMAT(5,2);
DO LINE←LINE&" " UNTIL LENGTH(LINE)=70; LINE←LINE&'15&'12;
SAVER←SAVER[1 TO USA+64]&CVS(DUM)&'15&'12&LINE&SAVER[USA+72 TO 5000];
DONE;
END;
END;
COMMENT if this is the first time this month add a line for this
sponsor;
IF NOT FLAGER THEN
BEGIN
DO LINE←LINE&" " UNTIL LENGTH(LINE)=70; LINE←LINE&'15&'12;
SETFORMAT(5,2);
LINE←LINE[1 TO 65]&CVS(DUM)&LINE[71 TO 72];
SAVER←SAVER&LINE;
K←K+1;
END;
IF EQU(FILETO[1 TO 1],"|") THEN DONE ELSE STT←LOP(FILETO);
END;
END;
LINE←SAVER; PUT; PUT;
LINE←"The labels are in file "&MONTH[1 TO 3]&"LAB, and can be listed whenever the"; PUT;
LINE←"avery labels have been mounted on the printer by the monitor command"; PUT;
LINE←"SP "&MONTH[1 TO 3]&"LAB<cr>. Don't forget to delete the file after listing it."; PUT;
PUT;
SETFORMAT(-4,2);
LINE←"The price was determined by operator input or at a rate of $"&CVF(PRICER); PUT;
SETFORMAT(3,2);
LINE←"per page. There will be "&CVS(COPIES)&" masters of the order form printed."; PUT;
LETTER←LETTER&'14;
OUT(C4,LETTER);
CLOSE(C3);
CLOSE(C4);
END;
LABELS;
FORM;
PRT,"Order forms and summaries are in the file: INFORM.",CRLF);
END "MAKE";
COMMENT some HELP;
DEFINE HP=⊂PRT,CRLF,CRLF," HELP FOR THE MAKEML FUNCTION",CRLF,CRLF,
"THIS PROGRAM WILL: 1. Produce the mailing labels on a ",CRLF,
" temporary file so you can list ",CRLF,
" them on the printer. ",CRLF,
" 2. Produce master copies of the mailing ",CRLF,
" list order form. ",CRLF,
" 3. Build or update the files for the",CRLF,
" report information, and the orders received.",CRLF,
" 4. Provide summaries of the people ",CRLF,
" sent lists, and accounts responsible.",CRLF,CRLF,
"FOR EACH MAILING OF AN ABSTRACT A NEW FILE WILL BE OPENED,",CRLF,
"THESE ARE REFERRED TO AS MONTHLY FILES, BUT CAN BE SENT ",CRLF,
"AT ANY INTERVAL. ONCE A FILE IS OPENED YOU CAN CONTINUE ",CRLF,
"TO ADD REPORTS TO IT UNTIL THE MAILING LIST AND ABSTRACT",CRLF,
"ARE SENT AT WHICH TIME THE FILE WILL BE MARKED AS SENT AND YOU ",CRLF,
"WILL BE ASKED -MONTH- THE NEXT TIME YOU ENTER. ",CRLF,
" ",CRLF,
" WHEN YOU ENTER THE PROGRAM A CHECK IS MADE TO DETERMINE IF",CRLF,
"A FILE IS ALREADY OPEN, IF NOT YOU WILL BE ASKED THE MONTH, AND ",CRLF,
"A FILE WILL BE OPENED, IF ONE IS ALREADY OPEN YOU WILL BE ASKED",CRLF,
"IF YOU WISH TO ADD MORE REPORTS OR MAKE THE LABELS,LIST,ETC. ",CRLF,
" ",CRLF,
" ENTRIES ARE ADDED TO THE FILE THROUGH INTERACTION, IF AT ",CRLF,
"ANY TIME YOU ARE NOT SURE OF THE PROPER RESPONSE SIMPLY TYPE ?.",CRLF,
" ",CRLF,
" WHEN YOU HAVE FINISHED ADDING ENTRIES, YOU WILL BE ASKED ",CRLF,
"IF YOU WISH TO MAIL THE LISTING, IF SO THE REPORTS WILL BE GENERATED",CRLF,
"AND OUTPUT, AND THE FILE MARKED AS CLOSED FOR THAT MONTH.");⊃;
COMMENT MAKEML runs:
this will determine the month of the report file to use,
and call either BUILD or MAKE or both;
SETBREAK(1,'12,NULL,"IKP");
SETBREAK(2,'14,NULL,"IAP");
SETBREAK(3,'15,NULL,"IAP");
SETBREAK(4,'113,NULL,"IAP");
SETBREAK(5,'136,NULL,"IAP");
SETBREAK(6,'117,NULL,"IAP");
SETBREAK(7,'54,NULL,"IAP");
SETBREAK(8,'174,NULL,"IP");
SETBREAK(9,'52,NULL,"IP");
SETBREAK(10,'56,NULL,"IP");
SETBREAK(11,'60,NULL,"IP");
SETBREAK(12,'26,NULL,"IP");
LOOKUP(C3,"REPT.DSK",FLAG);
LOOKING←TRUE;
NEW←TRUE;
I←1;
PGIN;
DO BEGIN SCIN; END UNTIL (EQU(LINE[17 TO 17],"*")) OR (EQU(LINE[8 TO 10],"END"));
COMMENT this first loop determine the month of the report,and if it already
exists. if the report exists the operator has the option of either
adding to it or publishing it, or both. if the file does not exist
the operator is asked for the month, and it will be opened;
WHILE LOOKING DO
BEGIN
IF EQU(LINE[8 TO 10],"END") THEN
BEGIN
PRT,"MAKEML - Enter month *");
TTIN; PGIN;
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL
(EQU(LINE[14 TO 16],TYPEIN[1 TO 3])) OR
(EQU(LINE[8 TO 10],"END"));
MONTH←LINE[14 TO 16];
IF EQU(LINE[8 TO 10],"END") THEN
BEGIN
IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
IF EQU(TYPEIN[1 TO 4],"HELP") THEN HP;
IF NOT EQU(TYPEIN[1 TO 4],"HELP") THEN
PRTERR,
" <cr> TO EXIT",CRLF,
" HELP<cr> FOR A TUTORIAL",CRLF,
" LLLL<cr> MONTH TO BUILD THE MAIL LIST");
PGIN;
CONTINUE;
END ELSE DONE;
END ELSE
COMMENT this is for already existing list;
BEGIN
MONTH←LINE[14 TO 16];
PRT,"MAKEML - The ",LINE[14 TO 16]," list is open and will be used. ",
"Enter option *");
TTIN; NEW←FALSE;
IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
IF EQU(TYPEIN[1 TO 4],"HELP") THEN BEGIN HP; CONTINUE; END;
IF (NOT EQU(TYPEIN[1 TO 5],"BUILD")) AND
(NOT EQU(TYPEIN[1 TO 4],"MAIL")) THEN
BEGIN
PRTERR,
" <cr> - to exit makeml ",CRLF,
" HELP<cr> - for a brief tutorial ",CRLF,
" BUILD<cr> - to add to the report list ",CRLF,
" MAIL<cr> - to send the mail/order list");
END ELSE DONE;
END;
END;
IF NOT EQU(TYPEIN[1 TO 4],"MAIL") THEN BUILD;
WHILE LOOKING DO
BEGIN
IF EQU(TYPEIN[1 TO 4],"MAIL") THEN DONE;
PRT,"WOULD YOU LIKE TO MAIL THE LISTING NOW? (Y OR N)*");
TTIN;
IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
IF EQU(TYPEIN[1 TO 1],"N") THEN RETURN;
IF EQU(TYPEIN[1 TO 1],"Y") THEN DONE;
IF NOT EQU(TYPEIN[1 TO 1],"Y") THEN
PRTERR,
" <cr> to exit ",CRLF,
" N<cr> to exit ",CRLF,
" Y<cr> to make the mailing list,labels ",CRLF,
" and summaries",CRLF,
"IF YOU DO NOT MAIL THE LIST NOW, IT WILL REMAIN OPEN",CRLF,
"FOR ADDITIONAL REPORT ENTRIES, UNTIL MAILING TIME.");
END;
MAKE;
END "MAKEML";
END;